home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / m2gem106.lzh / CRYSTAL1.06 / SRC / CRYSTAL / AES.MOD < prev    next >
Encoding:
Modula Implementation  |  1993-12-12  |  10.6 KB  |  531 lines
  1. IMPLEMENTATION MODULE AES;
  2.  
  3. (*
  4. Global AES Definitions.
  5.  
  6. UK __DATE__ __TIME__
  7. *)
  8.  
  9. (*IMP_SWITCHES*)
  10.  
  11. FROM PORTAB    IMPORT UNSIGNEDWORD,NULL;
  12. #if (defined LPRM2) || (defined SPCM2) || (defined MAMM2)
  13. FROM SYSTEM    IMPORT SETREG,ADR,INLINE,VAL;
  14. FROM Register  IMPORT A1,D1;
  15. #elif (defined TDIM2) || (defined ANAM2) || (defined FTLM2)
  16. FROM SYSTEM    IMPORT SETREG,ADR,CODE;
  17. FROM Register  IMPORT A1,D1;
  18. #elif (defined HM2)
  19. FROM SYSTEM    IMPORT LOAD,ADR,CODE;
  20. FROM Register  IMPORT A1,D1;
  21. #elif (defined MM2)
  22. FROM SYSTEM    IMPORT ASSEMBLER,ADR,CAST;
  23. #elif (defined FSTM2)
  24. FROM SYSTEM    IMPORT ASSEMBLER,ADR,SEGMENT,OFFSET;
  25. #elif (defined SDSM2)
  26. FROM SYSTEM    IMPORT CODE,RegAX,RegBX,RegCX,RegDX,SWI,WORD,ADR,ADDRESS;
  27. #elif (defined LM2)
  28. FROM SYSTEM    IMPORT CODE,SWI,SETREG,AX,BX,CX,DX,ADR,ADDRESS;
  29. #elif (defined TSM2_1) || (defined GPM2)
  30. FROM AESSYS    IMPORT aes;
  31. FROM SYSTEM    IMPORT ADR;
  32. #elif (defined TSM2_2)
  33. FROM SYSTEM    IMPORT Seg,Ofs,WORD,BYTE;
  34. #endif
  35.  
  36. #if (defined LPRM2) || (defined SPCM2)
  37. PROCEDURE crystal;
  38.  
  39. CONST OpCode = 200;
  40.  
  41.   PROCEDURE Trap2;
  42.     CODE(4E42H);
  43.  
  44. BEGIN
  45.   SETREG(A1,ADR(Control)); (* lea     Control,a1 *)
  46.   INLINE(03C9H,0001H);     (* movep.l d1,1(a1)   *)
  47.   SETREG(D1,ADR(c));       (* move.l  #c,d1      *)
  48.   INLINE(303CH,OpCode);    (* move.w  #$C8,d0    *)
  49.   Trap2;                   (* trap    #2         *)
  50. END crystal;
  51.  
  52. #elif (defined TDIM2)
  53.   MODULE SystemCall;
  54.  
  55.   IMPORT Control,c,UNSIGNEDWORD,SETREG,ADR,CODE,A1,D1;
  56.   EXPORT crystal;
  57.  
  58.   PROCEDURE crystal;
  59.  
  60.   CONST trap2  = 4E42H;
  61.         OpCode = 200;
  62.  
  63.   BEGIN
  64.     SETREG(A1,ADR(Control)); (* lea     Control,a1 *)
  65.     CODE(03C9H,0001H);       (* movep.l d1,1(a1)   *)
  66.     SETREG(D1,ADR(c));       (* move.l  #c,d1      *)
  67.     CODE(303CH,OpCode);      (* move.w  #$C8,d0    *)
  68.     CODE(trap2);             (* trap    #2         *)
  69.   END crystal;
  70.  
  71.   BEGIN
  72.  
  73.   (* initialize control array *)
  74.  
  75.   WITH Control DO
  76.     OpCode:= 0;
  77.     SizeIntIn:= 0;
  78.     SizeIntOut:= 0;
  79.     SizeAddrIn:= 0;
  80.     SizeAddrOut:= 0;
  81.   END;
  82.  
  83.   END SystemCall;
  84.  
  85. #elif (defined FTLM2)
  86.   PROCEDURE crystal;
  87.  
  88.   CONST trap2  = 4E42H;
  89.         OpCode = 200;
  90.  
  91.   BEGIN
  92.     SETREG(A1,ADR(Control)); (* lea     Control,a1 *)
  93.     CODE(03C9H,0001H);       (* movep.l d1,1(a1)   *)
  94.     SETREG(D1,ADR(c));       (* move.l  #c,d1      *)
  95.     CODE(303CH,OpCode);      (* move.w  #$C8,d0    *)
  96.     CODE(trap2);             (* trap    #2         *)
  97.   END crystal;
  98.  
  99. #elif (defined ANAM2)
  100.   MODULE SystemCall;
  101.  
  102.   IMPORT Control,c,UNSIGNEDWORD,SETREG,ADR,CODE,A1,D1;
  103.   EXPORT crystal;
  104.  
  105.   PROCEDURE crystal;
  106.  
  107.   CONST trap2  = 4E42H;
  108.         OpCode = 200;
  109.  
  110.   BEGIN
  111.     SETREG(A1,ADR(Control)); (* lea     Control,a1 *)
  112.     CODE(03C9H,0001H);       (* movep.l d1,1(a1)   *)
  113.     SETREG(D1,ADR(c));       (* move.l  #c,d1      *)
  114.     CODE(303CH,OpCode);      (* move.w  #$C8,d0    *)
  115.     CODE(trap2);             (* trap    #2         *)
  116.   END crystal;
  117.  
  118.   BEGIN
  119.  
  120.   (* initialize control array *)
  121.  
  122.   WITH Control DO
  123.     OpCode:= CAST(UNSIGNEDWORD,0);
  124.     SizeIntIn:= CAST(UNSIGNEDWORD,0);
  125.     SizeIntOut:= CAST(UNSIGNEDWORD,0);
  126.     SizeAddrIn:= CAST(UNSIGNEDWORD,0);
  127.     SizeAddrOut:= CAST(UNSIGNEDWORD,0);
  128.   END;
  129.  
  130.   END SystemCall;
  131.  
  132. #elif (defined HM2)
  133.   MODULE SystemCall;
  134.  
  135.   IMPORT Control,c,LOAD,ADR,CODE,A1,D1;
  136.   EXPORT crystal;
  137.  
  138.   PROCEDURE crystal;
  139.  
  140.   CONST trap2  = 4E42H;
  141.         OpCode = 200;
  142.  
  143.   BEGIN
  144.     LOAD(ADR(Control),A1); (* lea     Control,a1 *)
  145.     CODE(03C9H);
  146.     CODE(0001H);           (* movep.l d1,1(a1)   *)
  147.     LOAD(ADR(c),D1);       (* move.l  #c,d1      *)
  148.     CODE(303CH);
  149.     CODE(OpCode);          (* move.w  #$C8,d0    *)
  150.     CODE(trap2);           (* trap    #2         *)
  151.   END crystal;
  152.  
  153.   BEGIN
  154.  
  155.   (* initialize control array *)
  156.  
  157.   WITH Control DO
  158.     OpCode:= 0;
  159.     SizeIntIn:= 0;
  160.     SizeIntOut:= 0;
  161.     SizeAddrIn:= 0;
  162.     SizeAddrOut:= 0;
  163.   END;
  164.  
  165.   END SystemCall;
  166.  
  167. #elif (defined MM2)
  168.   MODULE SystemCall;
  169.  
  170.   IMPORT ASSEMBLER,Control,c;
  171.   EXPORT crystal;
  172.  
  173.   PROCEDURE crystal;
  174.   (*$L-*)
  175.   CONST OpCode = 200;
  176.  
  177.   BEGIN
  178.     ASSEMBLER
  179.       LEA     Control,A1
  180.       MOVEP.L D1,1(A1)
  181.       MOVE.L  #c,D1
  182.       MOVE.W  #OpCode,D0
  183.       TRAP    #2
  184.     END;
  185.   END crystal;
  186.   (*$L=*)
  187.  
  188.   BEGIN
  189.  
  190.   (* initialize control array *)
  191.  
  192.   WITH Control DO
  193.     OpCode:= 0;
  194.     SizeIntIn:= 0;
  195.     SizeIntOut:= 0;
  196.     SizeAddrIn:= 0;
  197.     SizeAddrOut:= 0;
  198.   END;
  199.  
  200.   END SystemCall;
  201.  
  202. #elif (defined MSM2)
  203. PROCEDURE crystal;
  204. (*$L-*)
  205. CONST OpCode = 200;
  206.  
  207. BEGIN
  208.   (*$A+*)
  209.     LEA     Control,A1
  210.     MOVEP.L D1,1(A1)
  211.     MOVE.L  #c,D1
  212.     MOVE.W  #OpCode,D0
  213.     TRAP    #2
  214.   (*$A-*)
  215. END crystal;
  216. (*$L+*)
  217.  
  218. #elif (defined FSTM2)
  219.   MODULE SystemCall;
  220.  
  221.   IMPORT Control,c,SEGMENT,OFFSET,ASSEMBLER,UNSIGNEDWORD;
  222.   EXPORT crystal;
  223.  
  224.   VAR AESPBSEG: UNSIGNEDWORD;
  225.       AESPBOFS: UNSIGNEDWORD;
  226.  
  227.   PROCEDURE crystal(FuncNo,NIntIn,NIntOut,NAddrIn: UNSIGNEDWORD);
  228.  
  229.   CONST OpCode = 200;
  230.         GEM    = 0EFH;
  231.  
  232.   BEGIN
  233.     WITH Control DO
  234.       OpCode:= FuncNo;
  235.       SizeIntIn:= NIntIn;
  236.       SizeIntOut:= NIntOut;
  237.       SizeAddrIn:= NAddrIn;
  238.     END;
  239.  
  240.     ASM
  241.       MOV  AX,AESPBSEG
  242.       MOV  BX,AESPBOFS
  243.       MOV  CX,OpCode
  244.       MOV  DX,0
  245.       MOV  ES,AX
  246.       INT  GEM
  247.     END;
  248.   END crystal;
  249.  
  250.   BEGIN
  251.     AESPBSEG:= SEGMENT(c);
  252.     AESPBOFS:= OFFSET(c);
  253.     Control.SizeAddrOut:= 0;
  254.   END SystemCall;
  255.  
  256. #elif (defined LM2)
  257. PROCEDURE crystal(FuncNo,NIntIn,NIntOut,NAddrIn: UNSIGNEDWORD);
  258.  
  259. CONST OpCode = 200;
  260.       GEM    = 0EFH;
  261.  
  262. VAR AESPBADR: ADDRESS;
  263.     AESPBSEG: CARDINAL;
  264.     AESPBOFS: CARDINAL;
  265.  
  266. BEGIN
  267.   WITH Control DO
  268.     OpCode:= FuncNo;
  269.     SizeIntIn:= NIntIn;
  270.     SizeIntOut:= NIntOut;
  271.     SizeAddrIn:= NAddrIn;
  272.   END;
  273.  
  274.   AESPBADR:= ADR(c);
  275.  
  276.   AESPBSEG:= AESPBADR.SEGMENT;
  277.   AESPBOFS:= AESPBADR.OFFSET;
  278.  
  279.   SETREG(AX,AESPBSEG); (* AESPBSEG must be a local variable *)
  280.   SETREG(BX,AESPBOFS); (* AESPBOFS must be a local variable *)
  281.   SETREG(CX,OpCode);
  282.   SETREG(DX,0);
  283.   CODE(8EH,C0H); (* mov  es,ax *)
  284.   SWI(GEM);
  285. END crystal;
  286.  
  287. #elif (defined SDSM2)
  288. PROCEDURE crystal(FuncNo,NIntIn,NIntOut,NAddrIn: UNSIGNEDWORD);
  289.  
  290. CONST OpCode = 200;
  291.       GEM    = 0EFH;
  292.  
  293. TYPE Address = RECORD
  294.                  CASE: BOOLEAN OF
  295.                    TRUE:
  296.                      Adr: ADDRESS;
  297.                  | FALSE:
  298.                      Ofs: WORD;
  299.                      Seg: WORD;
  300.                  END;
  301.                END;
  302.  
  303. VAR AESPBADR: Address;
  304.  
  305. BEGIN
  306.   WITH Control DO
  307.     OpCode:= FuncNo;
  308.     SizeIntIn:= NIntIn;
  309.     SizeIntOut:= NIntOut;
  310.     SizeAddrIn:= NAddrIn;
  311.   END;
  312.   AESPBADR.Adr:= ADR(c);
  313.   RegAX:= AESPBADR.Seg;
  314.   RegBX:= AESPBADR.Ofs;
  315.   RegCX:= OpCode;
  316.   RegDX:= 0;
  317.   CODE(8EH,C0H); (* mov  es,ax *)
  318.   SWI(GEM);
  319. END crystal;
  320.  
  321. #elif (defined TSM2_1) || (defined GPM2)
  322.   MODULE SystemCall;
  323.  
  324.   IMPORT Control,aes,c,UNSIGNEDWORD;
  325.   EXPORT crystal;
  326.  
  327.   PROCEDURE crystal(FuncNo,NIntIn,NIntOut,NAddrIn: UNSIGNEDWORD);
  328.   BEGIN
  329.     WITH Control DO
  330.       OpCode:= FuncNo;
  331.       SizeIntIn:= NIntIn;
  332.       SizeIntOut:= NIntOut;
  333.       SizeAddrIn:= NAddrIn;
  334.     END;
  335.     aes(c);
  336.   END crystal;
  337.  
  338.   BEGIN
  339.     Control.SizeAddrOut:= 0;
  340.   END SystemCall;
  341.  
  342. #elif (defined TSM2_2)
  343.   MODULE SystemCall;
  344.  
  345.   IMPORT Control,c,Seg,Ofs,WORD,BYTE,UNSIGNEDWORD;
  346.   EXPORT crystal;
  347.  
  348.   PROCEDURE crystal(FuncNo,NIntIn,NIntOut,NAddrIn: UNSIGNEDWORD);
  349.  
  350.   CONST OpCode = 200;
  351.         GEM    = 0EFH;
  352.  
  353.   TYPE CODE = ARRAY[0..3] OF BYTE;
  354.  
  355.   (*#call(inline=>on) *)
  356.   PROCEDURE aes(seg: WORD; (* -> AX *)
  357.                 ofs: WORD; (* -> BX *)
  358.                 opc: WORD; (* -> CX *)
  359.                 zer: WORD) (* -> DX *)
  360.             = CODE(08EH,0C0H, (* mov es,ax *)
  361.                    0CDH,GEM); (* int GEM   *)
  362.   (*#call(inline=>off) *)
  363.  
  364.   BEGIN
  365.     WITH Control DO
  366.       OpCode:= FuncNo;
  367.       SizeIntIn:= NIntIn;
  368.       SizeIntOut:= NIntOut;
  369.       SizeAddrIn:= NAddrIn;
  370.     END;
  371.     aes(Seg(c),Ofs(c),OpCode,0);
  372.   END crystal;
  373.  
  374.   BEGIN
  375.     Control.SizeAddrOut:= 0;
  376.   END SystemCall;
  377.  
  378. #elif (defined XHM2)
  379.   MODULE SystemCall;
  380.  
  381.   IMPORT Control,c,UNSIGNEDWORD;
  382.   EXPORT crystal;
  383.  
  384.   PROCEDURE crystal(FuncNo,NIntIn,NIntOut,NAddrIn: UNSIGNEDWORD);
  385.   BEGIN
  386.     WITH Control DO
  387.       OpCode:= FuncNo;
  388.       SizeIntIn:= NIntIn;
  389.       SizeIntOut:= NIntOut;
  390.       SizeAddrIn:= NAddrIn;
  391.     END;
  392.  
  393.   END crystal;
  394.  
  395.   BEGIN
  396.  
  397.   END SystemCall;
  398.  
  399. #elif (defined XAM2)
  400.   MODULE SystemCall;
  401.  
  402.   IMPORT Control,c,UNSIGNEDWORD;
  403.   EXPORT crystal;
  404.  
  405.   PROCEDURE crystal(FuncNo,NIntIn,NIntOut,NAddrIn: UNSIGNEDWORD);
  406.   BEGIN
  407.     WITH Control DO
  408.       OpCode:= FuncNo;
  409.       SizeIntIn:= NIntIn;
  410.       SizeIntOut:= NIntOut;
  411.       SizeAddrIn:= NAddrIn;
  412.     END;
  413.  
  414.   END crystal;
  415.  
  416.   BEGIN
  417.  
  418.   END SystemCall;
  419.  
  420. #elif (defined XGM2)
  421.   MODULE SystemCall;
  422.  
  423.   IMPORT Control,c,UNSIGNEDWORD;
  424.   EXPORT crystal;
  425.  
  426.   PROCEDURE crystal(FuncNo,NIntIn,NIntOut,NAddrIn: UNSIGNEDWORD);
  427.   BEGIN
  428.     WITH Control DO
  429.       OpCode:= FuncNo;
  430.       SizeIntIn:= NIntIn;
  431.       SizeIntOut:= NIntOut;
  432.       SizeAddrIn:= NAddrIn;
  433.     END;
  434.  
  435.   END crystal;
  436.  
  437.   BEGIN
  438.  
  439.   END SystemCall;
  440. #elif (defined XRM2)
  441.   MODULE SystemCall;
  442.  
  443.   IMPORT Control,c,UNSIGNEDWORD;
  444.   EXPORT crystal;
  445.  
  446.   PROCEDURE crystal(FuncNo,NIntIn,NIntOut,NAddrIn: UNSIGNEDWORD);
  447.   BEGIN
  448.     WITH Control DO
  449.       OpCode:= FuncNo;
  450.       SizeIntIn:= NIntIn;
  451.       SizeIntOut:= NIntOut;
  452.       SizeAddrIn:= NAddrIn;
  453.     END;
  454.  
  455.   END crystal;
  456.  
  457.   BEGIN
  458.  
  459.   END SystemCall;
  460. #endif
  461.  
  462. PROCEDURE Error(): BOOLEAN;
  463. BEGIN
  464.   RETURN IntOut[0] = 0;
  465. END Error;
  466.  
  467. PROCEDURE Version(): UNSIGNEDWORD;
  468.  
  469. VAR Ver: UNSIGNEDWORD;
  470.  
  471. BEGIN
  472.   Ver:= Global.ApVersion;
  473.   IF (Ver >= 0200H) AND (Ver <= 0220H) THEN
  474.     RETURN 0220H; (* GEM 2.x *)
  475. #if ST
  476.   ELSIF KAOS THEN
  477.     RETURN 1042H; (* 1042H for all versions of KAOS-GEM *)
  478. #endif
  479.   ELSE
  480.     RETURN Ver;
  481.   END;
  482. END Version;
  483.  
  484. BEGIN
  485. #if no_local_modules
  486. #if Seimet
  487.   (* initialize control array *)
  488.  
  489.   WITH Control DO
  490.     OpCode:= 0;
  491.     SizeIntIn:= 0;
  492.     SizeIntOut:= 0;
  493.     SizeAddrIn:= 0;
  494.     SizeAddrOut:= 0;
  495.   END;
  496. #else
  497.   (* initialize control array *)
  498.  
  499.   Control.SizeAddrOut:= 0;
  500. #endif
  501. #endif
  502.  
  503.   (* initialize AES parameter block *)
  504.  
  505.   WITH c DO
  506.     PControl:= ADR(Control);
  507.     PGlobal:= ADR(Global);
  508.     PIntIn:= ADR(IntIn);
  509.     PIntOut:= ADR(IntOut);
  510.     PAdrIn:= ADR(Addr);
  511.     PAdrOut:= ADR(Addr[2]); (* AES.MaxAddress is 3 *)
  512.   END;
  513.  
  514.   (* initialize Global *)
  515.  
  516.   WITH Global DO
  517.     ApVersion:= 0;
  518. (*  ApPTree:= NULL; done in RsrcMgr.Mod *)
  519.     ApPMem:= NULL;
  520.   END;
  521.  
  522.   (* initialize IntOut[0] *)
  523.  
  524.   IntOut[0]:= -1;
  525.  
  526. #if ST
  527.   KAOS:= FALSE;
  528. #endif
  529.  
  530. END AES.
  531.